home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / drives.swg / 0077_DPMI Read-Write Sectors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  6.7 KB  |  285 lines
  1. {$S-,R-,V-,I-,B-,F+,O+,A-,X+}
  2.  
  3. unit DDisk;
  4.   {-Read and write absolute sectors using DOS int $25 and $26
  5.     in protected mode under DOS or Windows. Does not support real mode.
  6.     Requires BP7 or TPW 1.5.
  7.  
  8.     Based on the code in the OPDOS unit from Object Professional.
  9.  
  10.     Thanks to Maynard Riley and Mark Boler for work done on this unit.
  11.  
  12.     Notes:
  13.       The calling parameters correspond to those in OPDOS.
  14.       Drive = 0 corresponds to drive A.
  15.       Sectors are typically 512 bytes each. NumSects*SectorSize must be
  16.         less than 64K.
  17.       Buf may be any buffer in a protected mode program. DDISK
  18.         temporarily allocates a DOS real mode buffer, then copies
  19.         the result into or out of Buf.
  20.       If the function returns False, the DosError variable from the
  21.         DOS or WINDOS unit may have a non-zero value with more information
  22.         about the failure.
  23.  
  24.       Use DPMIWriteDiskSectors with caution!
  25.  
  26.     Version 1.0 (first public release) 7/19/94
  27.  
  28.     For more information, contact TurboPower Software
  29.     CompuServe 76004,2611
  30.   }
  31.  
  32. interface
  33.  
  34. function DPMIReadDiskSectors(Drive : Word;
  35.                              FirstSect : LongInt; NumSects : Word;
  36.                              var Buf) : Boolean;
  37.   {-Read sectors using int $25}
  38.  
  39. function DPMIWriteDiskSectors(Drive : Word;
  40.                               FirstSect : LongInt; NumSects : Word;
  41.                               var Buf) : Boolean;
  42.   {-Write sectors using int $26}
  43.  
  44.   {====================================================================}
  45.  
  46. implementation
  47.  
  48. uses
  49. {$IFDEF DPMI}
  50.   DOS,
  51. {$ELSE}
  52.   WinDOS,
  53. {$ENDIF}
  54.   WinAPI;
  55.  
  56. type
  57.   DpmiRealBuf =
  58.     object
  59.  
  60.     private
  61.       Bytes   : LongInt;
  62.       BufBase : LongInt;
  63.  
  64.     public
  65.       constructor Init(BufBytes : LongInt);
  66.       destructor Done;
  67.       function Size : LongInt;
  68.       function Segment : Word;
  69.       function Selector : Word;
  70.       function RealPtr : Pointer;
  71.       function ProtPtr : Pointer;
  72.     end;
  73.  
  74.   DPMIRegisters =
  75.     record
  76.       DI : LongInt;
  77.       SI : LongInt;
  78.       BP : LongInt;
  79.       Reserved : LongInt;
  80.       BX : LongInt;
  81.       DX : LongInt;
  82.       CX : LongInt;
  83.       AX : LongInt;
  84.       Flags : Word;
  85.       ES : Word;
  86.       DS : Word;
  87.       FS : Word;
  88.       GS : Word;
  89.       IP : Word;
  90.       CS : Word;
  91.       SP : Word;
  92.       SS : Word;
  93.     end;
  94.  
  95.   PacketPtr = ^PacketRec;
  96.   PacketRec =
  97.     record
  98.       StartLo : Word;
  99.       StartHi : Word;
  100.       Count : Word;
  101.       BufOfs : Word;
  102.       BufSeg : Word;
  103.     end;
  104.  
  105.   procedure GetRealModeIntVector(IntNo : Byte; var Vector : Pointer); assembler;
  106.   asm
  107.     mov     ax,0200h
  108.     mov     bl,IntNo
  109.     int     31h
  110.     les     di,Vector
  111.     mov     word ptr es:[di],dx
  112.     mov     word ptr es:[di+2],cx
  113.   end;
  114.  
  115.   function CallFarRealModeProc(var Regs : DPMIRegisters) : Word; assembler;
  116.   asm
  117.     mov     ax,0301h
  118.     xor     bx,bx
  119.     xor     cx,cx
  120.     les     di,Regs
  121.     int     31h
  122.     jc      @@9
  123.     xor     ax,ax
  124. @@9:
  125.   end;
  126.  
  127.   function DpmiRealBuf.Segment : Word;
  128.   begin
  129.     Segment := BufBase shr 16;
  130.   end;
  131.  
  132.   function DpmiRealBuf.Selector : Word;
  133.   begin
  134.     Selector := BufBase and $FFFF;
  135.   end;
  136.  
  137.   function DpmiRealBuf.RealPtr : Pointer;
  138.   begin
  139.     RealPtr := Ptr(BufBase shr 16, 0);
  140.   end;
  141.  
  142.   function DpmiRealBuf.ProtPtr : Pointer;
  143.   begin
  144.     ProtPtr := Ptr(BufBase and $FFFF, 0);
  145.   end;
  146.  
  147.   function DpmiRealBuf.Size : LongInt;
  148.   begin
  149.     Size := Bytes;
  150.   end;
  151.  
  152.   constructor DpmiRealBuf.Init(BufBytes : LongInt);
  153.   begin
  154.     BufBase := GlobalDosAlloc(BufBytes);
  155.     if BufBase = 0 then
  156.       Fail;
  157.     Bytes := BufBytes;
  158.   end;
  159.  
  160.   destructor DpmiRealBuf.Done;
  161.   begin
  162.     GlobalDosFree(Selector);
  163.   end;
  164.  
  165. type
  166.   DiskInfoRec =
  167.     object
  168.       DriveNumber : Byte;
  169.       ClustersAvailable : Word;
  170.       TotalClusters : Word;
  171.       BytesPerSector : Word;
  172.       SectorsPerCluster : Word;
  173.       constructor Init(d : Byte);
  174.     end;
  175.  
  176.   constructor DiskInfoRec.Init(d : Byte);
  177.   var
  178.     Ok : Boolean;
  179.   begin
  180.     DriveNumber := d; { 0 = default ; 1 = 'A' }
  181.  
  182.     asm
  183.       mov     dl,d
  184.       mov     ah,$36
  185.       int     $21
  186.       cmp     ax,$FFFF
  187.       je      @8
  188.  
  189.       les     di,Self
  190.       mov     es:[di].SectorsPerCluster,ax
  191.       mov     es:[di].ClustersAvailable,bx
  192.       mov     es:[di].BytesPerSector,cx
  193.       mov     es:[di].TotalClusters,dx
  194.       mov     al,True
  195.       jmp     @9
  196.  
  197. @8:   mov     al,False
  198. @9:   mov     Ok,al
  199.     end;
  200.  
  201.     if not Ok then
  202.       Fail;
  203.   end;
  204.  
  205.   function DPMIReadWrite(Drive : Word;
  206.                          FirstSect : LongInt; NumSects : Word;
  207.                          var Buf; Vector : Byte) : Boolean;
  208.   var
  209.     SaveInt : Pointer;
  210.     Status : Word;
  211.     BufBytes : LongInt;
  212.     DiskInfo : DiskInfoRec;
  213.     InterimBuf : DpmiRealBuf;
  214.     PacketBuf : DpmiRealBuf;
  215.     Regs : DPMIRegisters;
  216.   begin
  217.     DosError := 0;
  218.     DPMIReadWrite := False;
  219.  
  220.     if not DiskInfo.Init(Drive+1) then
  221.       Exit;
  222.  
  223.     BufBytes := LongInt(NumSects)*DiskInfo.BytesPerSector;
  224.     if BufBytes > 65535 then
  225.       Exit;
  226.     if not InterimBuf.Init(BufBytes) then
  227.       Exit;
  228.  
  229.     if not PacketBuf.Init(SizeOf(PacketRec)) then begin
  230.       InterimBuf.Done;
  231.       Exit;
  232.     end;
  233.  
  234.     if Vector = $26 then
  235.       Move(Buf, InterimBuf.ProtPtr^, BufBytes);
  236.  
  237.     FillChar(Regs, SizeOf(Regs), 0);
  238.     with PacketPtr(PacketBuf.ProtPtr)^ do begin
  239.       StartLo := FirstSect and $FFFF;
  240.       StartHi := FirstSect shr 16;
  241.       Count := NumSects;
  242.       BufOfs := 0;
  243.       BufSeg := InterimBuf.Segment;
  244.     end;
  245.  
  246.     GetRealModeIntVector(Vector, SaveInt); { returns real mode seg:ofs }
  247.     with Regs do begin
  248.       CX := $FFFF;
  249.       AX := Drive;
  250.       BX := 0;
  251.       DS := PacketBuf.Segment;
  252.       CS := LongInt(SaveInt) shr 16;
  253.       IP := LongInt(SaveInt) and $FFFF;
  254.     end;
  255.     Status := CallFarRealModeProc(Regs);
  256.  
  257.     if Status = 0 then
  258.       if Odd(Regs.Flags) then
  259.         DosError := Regs.AX
  260.       else begin
  261.         if Vector = $25 then
  262.           Move(InterimBuf.ProtPtr^, Buf, BufBytes);
  263.         DPMIReadWrite := True;
  264.       end;
  265.  
  266.     PacketBuf.Done;
  267.     InterimBuf.Done;
  268.   end;
  269.  
  270.   function DPMIReadDiskSectors(Drive : Word;
  271.                                FirstSect : LongInt; NumSects : Word;
  272.                                var Buf) : Boolean;
  273.   begin
  274.     DPMIReadDiskSectors := DPMIReadWrite(Drive, FirstSect, NumSects, Buf, $25);
  275.   end;
  276.  
  277.   function DPMIWriteDiskSectors(Drive : Word;
  278.                                 FirstSect : LongInt; NumSects : Word;
  279.                                 var Buf) : Boolean;
  280.   begin
  281.     DPMIWriteDiskSectors := DPMIReadWrite(Drive, FirstSect, NumSects, Buf, $26);
  282.   end;
  283.  
  284. end.
  285.